perm filename PREDIC.LSP[BNF,JRA] blob
sn#027883 filedate 1973-03-06 generic text, type T, neo UTF8
(DEFPROP <PREDIC>
(LAMBDA NIL
(NLRR (QUOTE PREDIC)
(FUNCTION
(LAMBDA NIL
(COND ((AND (SPWD ANCESTRY)) (QUOTE ANCESTRY))
((AND (SPWD NONE)) (QUOTE NONE))
((AND (SPWD VINE)) (QUOTE VINE))
((AND (SPWD UNIT)) (QUOTE UNIT))
((AND (SPWD P1)) (QUOTE ALLPOS))
((AND (SPWD P2)) (QUOTE ALLNEG))
((AND (SPWD SUPPORT) (CH /[) (<C>) (CH /])) (CONS (QUOTE SUPPORT) (STK 1)))
((AND (SPWD DEPTH) (CH /[) (<NUMBER>) (CH /]))
(CONS (QUOTE GREATERP)
(CONS (CONS (QUOTE DEPTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL))
(CONS (STK 1) NIL))))
((AND (SPWD SELDEPTH) (CH /[) (<FNLSTP>) (CH /])) (CONS (QUOTE DEP) (STK 1)))
((AND (SPWD LENGTH) (CH /[) (<NUMBER>) (CH /]))
(CONS (QUOTE GREATERP)
(CONS (CONS (QUOTE LENGTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL))
(CONS (STK 1) NIL))))
((AND (SPWD MODEL) (CH /[) (<PREDLST>) (CH ;) (<PREDLST1>) (CH /]))
(CONS (QUOTE MODEL) (CONS (STK 3) (CONS (STK 1) NIL))))
((AND (SPWD EQUALITY) (CH /[) (<OP>) (CH /,) (<NUMBER>) (CH /]))
(CONS (QUOTE EQUALITY) (CONS (STK 3) (CONS (STK 1) NIL))))
((AND (SPWD DEMOD) (CH /[) (<CLAUSES>) (<NUMBER>) (CH /]))
(CONS (QUOTE DEMOD) (CONS (STK 2) (CONS (STK 1) NIL))))
((AND (SPWD DEFMODEL) (CH /[) (SPWD ID) (CH /])) (CONS (QUOTE DEFMODEL) (QUOTE ID)))
((AND (CH /@) (<LISPR>)) (STK 0))
((AND (<TERM0>) (<OPR>) (<TERM>)) (CONS (STK 1) (CONS (STK 2) (CONS (STK 0) NIL))))
(*NIL*))))))
EXPR)
(DEFPROP <PREDLST1>
(LAMBDA NIL (NLRR (QUOTE PREDLST1) (FUNCTION (LAMBDA NIL (COND ((AND (<PREDLST>)) (STK 0)) (*NIL*))))))
EXPR)
(DEFPROP <PREDLST>
(LAMBDA NIL
(NLRR (QUOTE PREDLST)
(FUNCTION
(LAMBDA NIL
(COND ((AND (<ID>) (CH /,) (<PREDLST>)) (CONS (STK 2) (STK 0)))
((AND (<ID>)) (STK 0))
((AND) NIL)
(*NIL*))))))
EXPR)
(DEFPROP <FNLSTP>
(LAMBDA NIL
(NLRR (QUOTE FNLSTP)
(FUNCTION
(LAMBDA NIL
(COND ((AND (<FP>) (CH ;) (<FNLSTP>)) (CONS (STK 2) (STK 0)))
((AND (<FP>)) (CONS (STK 0) NIL))
(*NIL*))))))
EXPR)
(DEFPROP <FP>
(LAMBDA NIL
(NLRR (QUOTE FP)
(FUNCTION (LAMBDA NIL (COND ((AND (<OP>) (CH /,) (<NUMBER>)) (CONS (STK 2) (STK 0))) (*NIL*))))))
EXPR)
(DEFPROP >PREDIC<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((EQ (QUOTE ANCESTRY) (STK1)) (QUOTE ANCESTRY))
((EQ (QUOTE NONE) (STK1)) (QUOTE NONE))
((EQ (QUOTE VINE) (STK1)) (QUOTE VINE))
((EQ (QUOTE UNIT) (STK1)) (QUOTE UNIT))
((EQ (QUOTE ALLPOS) (STK1)) (QUOTE P1))
((EQ (QUOTE ALLNEG) (STK1)) (QUOTE P2))
((AND (MATCH (QUOTE (SUPPORT . *))) (>C< 0))
(LIST (QUOTE SUPPORT) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (GREATERP (DEPTH (CDR C)) *))) (>NUMBER< 0))
(LIST (QUOTE DEPTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (DEP . *))) (>FNLSTP< 0))
(LIST (QUOTE SELDEPTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (GREATERP (LENGTH (CDR C)) *))) (>NUMBER< 0))
(LIST (QUOTE LENGTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (MODEL * *))) (>PREDLST< 1) (>PREDLST1< 0))
(LIST (QUOTE MODEL) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH ;)) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (EQUALITY * *))) (>OP< 1) (>NUMBER< 0))
(LIST (QUOTE EQUALITY) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (DEMOD * *))) (>CLAUSES< 1) (>NUMBER< 0))
(LIST (QUOTE DEMOD) (QUOTE (:CH /[)) (STK1) (STK0) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (DEFMODEL . ID))))
(LIST (QUOTE DEFMODEL) (QUOTE (:CH /[)) (QUOTE ID) (QUOTE (:CH /]))))
((AND (MATCH (QUOTE (* * *))) (>OPR< 2) (>TERM0< 1) (>TERM< 0)) (LIST (STK1) (STK2) (STK0)))
((>LISPR< 1) (LIST (QUOTE (:CH /@)) (STK1))))))))
EXPR)
(DEFPROP >PREDLST1<
(LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>PREDLST< 1) (STK1)))))))
EXPR)
(DEFPROP >PREDLST<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
((AND (MATCH (QUOTE (* . *))) (>ID< 1) (>PREDLST< 0)) (LIST (STK1) (QUOTE (:CH /,)) (STK0)))
((>ID< 1) (STK1)))))))
EXPR)
(DEFPROP >FNLSTP<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((AND (MATCH (QUOTE (*))) (>FP< 0)) (STK0))
((AND (MATCH (QUOTE (* . *))) (>FP< 1) (>FNLSTP< 0))
(LIST (STK1) (QUOTE (:CH ;)) (STK0))))))))
EXPR)
(DEFPROP >FP<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND
((AND (MATCH (QUOTE (* . *))) (>OP< 1) (>NUMBER< 0)) (LIST (STK1) (QUOTE (:CH /,)) (STK0))))))))
EXPR)